home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
magazine
/
drdobbs
/
1988
/
09
/
king.lis
< prev
next >
Wrap
File List
|
1988-08-22
|
11KB
|
460 lines
_ADA FOR PASCAL PROGRAMMERS_
by
Kim King
Example 1: A Pascal program that counts occurrences of letters
in the input stream
program CountLetters(input, output);
{ counts occurrences of letters in the input stream }
var Counts: array ['a'..'z'] of integer;
Ch: char;
begin
for Ch := 'a' to 'z' do
Counts[Ch] := 0;
while not eof do
begin
read(Ch);
if ('a' <= Ch) and (Ch <= 'z') then
Counts[Ch] := Counts[Ch] + 1
else if ('A' <= Ch) and (Ch <= 'Z') then
begin
Ch := chr(ord(Ch) - ord('A') + ord('a'));
Counts[Ch] := Counts[Ch] + 1
end
end;
for Ch := 'a' to 'z' do
writeln(Ch, Counts[Ch]:6)
end.
Example 2: An Ada program that counts occurrences of letters in
the input stream
1. with Text_IO; use Text_IO;
2. procedure Count_Letters is
3. -- counts occurrences of letters in the input stream
4. package Int_IO is new Integer_IO(Integer);
5. use Int_IO;
6. Counts: array ('a'..'z') of Integer := (others => 0);
7. Ch: Character;
8. begin
9. while not End_Of_File loop
10. Get(Ch);
11. if 'a' <= Ch and Ch <= 'z' then
12. Counts(Ch) := Counts(Ch) + 1;
13. elsif 'A' <= Ch and Ch <= 'Z' then
14. Ch := Character'Val(Character'Pos(Ch) -
15. Character'Pos('A') +
16. Character'Pos('a'));
17. Counts(Ch) := Counts(Ch) + 1;
18. end if;
19. end loop;
20. for Ch in 'a'..'z' loop
21. Put(Ch);
22. Put(Counts(Ch), 6);
23. New_Line;
24. end loop;
25. end Count_Letters;
Example 3: Overloading the Put procedure
procedure Put(File: File_Type; Item: Character);
procedure Put(Item: Character);
procedure Put(File: File_Type; Item: String);
procedure Put(Item: String);
Example 4: The specification of the Length_Conversions package
package Length_Conversions is
Feet_To_Meters: constant := 0.3048;
Inches_To_Centimeters: constant := 2.54;
Miles_To_Kilometers: constant := 1.6093;
Yards_To_Meters: constant := 0.9144;
end Length_Conversions;
Example 5: A program that uses the Length_Conversions package
with Text_IO, Length_Conversions;
use Text_IO, Length_Conversions;
procedure Convert_To_Meters is
package Int_IO is new Integer_IO(Integer);
use Int_IO;
Feet: Integer;
begin
Put("Enter a measurement in feet: ");
Get(Feet);
Skip_Line;
Put("The equivalent measurement in meters is: ");
Put(Integer(Float(Feet)*Feet_To_Meters), 1);
New_Line;
end Convert_To_Meters;
Example 6: The specification of the Angle_Conversions package
package Angle_Conversions is
function Degrees_To_Radians(Degrees: Float) return Float;
function Radians_To_Degrees(Radians: Float) return Float;
end Angle_Conversions;
Example 7: The body of the Angle_Conversions package
package body Angle_Conversions is
Two_Pi: constant := 2.0 * 3.14159;
function Degrees_To_Radians(Degrees: Float) return Float is
begin
return Two_Pi * Degrees / 360.0;
end Degrees_To_Radians;
function Radians_To_Degrees(Radians: Float) return Float is
begin
return 360.0 * Radians / Two_Pi;
end Radians_To_Degrees;
end Angle_Conversions;
Example 8: The specification of the Char_Stack package
package Char_Stack is
procedure Push(X: Character);
-- pushes X onto the stack
procedure Pop(X: out Character);
-- stores the top stack element into X, then pops the stack
function Is_Empty return Boolean;
-- returns True if the stack is empty, False otherwise
end Char_Stack;
Example 9: The body of the Char_Stack package
package body Char_Stack is
Stack_Size: constant := 100; --maximum size of stack
Stack_Array: array (1..Stack_Size) of Character;
Top_Of_Stack: Integer range 0..Stack_Size := 0;
procedure Push(X: Character) is
begin
Top_Of_Stack := Top_Of_Stack + 1;
Stack_Array(Top_Of_Stack) := X;
end Push;
procedure Pop(X: out Character) is
begin
X := Stack_Array(Top_Of_Stack);
Top_Of_Stack := Top_Of_Stack - 1;
end Pop;
function Is_Empty return Boolean is
begin
return Top_Of_Stack = 0;
end Is_Empty;
end Char_Stack;
Example 10: A program that uses the Char_Stack package to reverse
a string
with Text_IO, Char_Stack;
use Text_IO, Char_Stack;
procedure Reverse_String is
Ch: Character;
begin
Put("Enter string to be reversed: ");
while not End_Of_Line loop
Get(Ch);
Push(Ch);
end loop;
Skip_Line;
Put("The reversal is: ");
while not Is_Empty loop
Pop(Ch);
Put(Ch);
end loop;
New_Line;
end Reverse_String;
Example 11: The specification of the Char_Stacks package;
Char_Stack is an ordinary type
package Char_Stacks is
Stack_Size: constant := 100;
type Array_Type is array (1..Stack_Size) of Character;
type Char_Stack is
record
Stack_Array: Array_Type;
Top_Of_Stack: Integer range 0..Stack_Size := 0;
end record;
procedure Push(S: in out Char_Stack; X: Character);
-- pushes X onto stack S
procedure Pop(S: in out Char_Stack; X: out Character);
-- stores the top element of S into X, then pops S
function Is_Empty(S: Char_Stack) return Boolean;
-- returns True if S is empty, False otherwise
end Char_Stacks;
Example 12: The specification of the Char_Stacks package;
Char_Stack is a private type
package Char_Stacks is
type Char_Stack is private;
procedure Push(S: in out Char_Stack; X: Character);
-- pushes X onto stack S
procedure Pop(S: in out Char_Stack; X: out Character);
-- stores the top element of S into X, then pops S
function Is_Empty(S: Char_Stack) return Boolean;
-- returns True if S is empty, False otherwise
private
Stack_Size: constant := 100;
type Array_Type is array (1..Stack_Size) of Character;
type Char_Stack is
record
Stack_Array: Array_Type;
Top_Of_Stack: Integer range 0..Stack_Size := 0;
end record;
end Char_Stacks;
Example 13: The body of the Char_Stacks package
package body Char_Stacks is
procedure Push(S: in out Char_Stack; X: Character) is
begin
S.Top_Of_Stack := S.Top_Of_Stack + 1;
S.Stack_Array(S.Top_Of_Stack) := X;
end Push;
procedure Pop(S: in out Char_Stack; X: out Character) is
begin
X := S.Stack_Array(S.Top_Of_Stack);
S.Top_Of_Stack := S.Top_Of_Stack - 1;
end Pop;
function Is_Empty(S: Char_Stack) return Boolean is
begin
return S.Top_Of_Stack = 0;
end Is_Empty;
end Char_Stacks;
Example 14: A program that uses the Char_Stacks package to
reverse a string
with Text_IO, Char_Stacks;
use Text_IO, Char_Stacks;
procedure Reverse_String is
S: Char_Stack;
Ch: Character;
begin
Put("Enter string to be reversed: ");
while not End_Of_Line loop
Get(Ch);
Push(S, Ch);
end loop;
Skip_Line;
Put("The reversal is: ");
while not Is_Empty(S) loop
Pop(S, Ch);
Put(Ch);
end loop;
New_Line;
end Reverse_String;
Example 15: The specification of the Char_Stacks package with
exceptions added
package Char_Stacks is
type Char_Stack is private;
procedure Push(S: in out Char_Stack; X: Character);
-- pushes X onto stack S; raises Overflow if S is full
procedure Pop(S: in out Char_Stack; X: out Character);
-- stores the top element of S into X, then pops S
-- raises Underflow if S is empty
function Is_Empty(S: Char_Stack) return Boolean;
-- returns True if S is empty, False otherwise
Overflow, Underflow: exception;
private
Stack_Size: constant := 100;
type Array_Type is array (1..Stack_Size) of Character;
type Char_Stack is
record
Stack_Array: Array_Type;
Top_Of_Stack: Integer range 0..Stack_Size := 0;
end record;
end Char_Stacks;
Example 16: The body of the Char_Stacks package with exceptions
added
package body Char_Stacks is
procedure Push(S: in out Char_Stack; X: Character) is
begin
if S.Top_Of_Stack = Stack_Size then
raise Overflow;
end if;
S.Top_Of_Stack := S.Top_Of_Stack + 1;
S.Stack_Array(S.Top_Of_Stack) := X;
end Push;
procedure Pop(S: in out Char_Stack; X: out Character) is
begin
if S.Top_Of_Stack = 0 then
raise Underflow;
end if;
X := S.Stack_Array(S.Top_Of_Stack);
S.Top_Of_Stack := S.Top_Of_Stack - 1;
end Pop;
function Is_Empty(S: Char_Stack) return Boolean is
begin
return S.Top_Of_Stack = 0;
end Is_Empty;
end Char_Stacks;
Example 17: A program that uses the Char_Stacks package to
reverse a string (with exception handling added)
with Text_IO, Char_Stacks;
use Text_IO, Char_Stacks;
procedure Reverse_String is
S: Char_Stack;
Ch: Character;
begin
Put("Enter string to be reversed: ");
begin
while not End_Of_Line loop
Get(Ch);
Push(S, Ch);
end loop;
exception
when Overflow => null; -- ignore overflow
end;
Skip_Line;
Put("The reversal is: ");
while not Is_Empty(S) loop
Pop(S, Ch);
Put(Ch);
end loop;
New_Line;
end Reverse_String;
Example 18: The specification of the generic Stacks package
generic
type Element is private;
package Stacks is
type Stack is private;
procedure Push(S: in out Stack; X: Element);
-- pushes X onto stack S; raises Overflow if S is full
procedure Pop(S: in out Stack; X: out Element);
-- stores the top element of S into X, then pops S
-- raises Underflow if S is empty
function Is_Empty(S: Stack) return Boolean;
-- returns True if S is empty, False otherwise
Overflow, Underflow: exception;
private
Stack_Size: constant := 100;
type Array_Type is array (1..Stack_Size) of Element;
type Stack is
record
Stack_Array: Array_Type;
Top_Of_Stack: Integer range 0..Stack_Size := 0;
end record;
end Stacks;
Example 19: A program that uses the generic Stacks package to
reverse a string
with Text_IO, Stacks;
use Text_IO;
procedure Reverse_String is
package Char_Stacks is new Stacks(Character);
use Char_Stacks;
S: Stack;
Ch: Character;
begin
Put("Enter string to be reversed: ");
begin
while not End_Of_Line loop
Get(Ch);
Push(S, Ch);
end loop;
exception
when Overflow => null;
end;
Skip_Line;
Put("The reversal is: ");
while not Is_Empty(S) loop
Pop(S, Ch);
Put(Ch);
end loop;
New_Line;
end Reverse_String;